package CHI::Driver::MMA;

use strict;
use warnings;

use IPC::MMA qw(:basic :hash);
use Mouse;
use File::Spec::Functions qw(catdir tmpdir);
use Carp qw(croak);

our $VERSION   = '1.0';
our $SEPARATOR = "\032";
our $MM;
our $HASH;

extends 'CHI::Driver';

=head1 NAME

CHI::Driver::DBI - Use DBI for cache storage

=head1 SYNOPSIS

 use CHI;

 my $dbh   = DBI->connect(...);
 my $cache = CHI->new( driver => 'DBI', dbh => $dbh, );
 OR
 my $cache = CHI->new( driver => 'DBI', dbh => $dbh, dbh_ro => $dbh_ro, );

=head1 DESCRIPTION

This driver uses a database table to store the cache.  The newest
versions of MySQL and SQLite work are known to work.  Other RDBMSes
should work.

Why cache things in a database?  Isn't the database what people are
trying to avoid with caches?  This is often true, but a simple primary
key lookup is extremely fast in many databases and this provides a
shared cache that can be used when less reliable storage like
memcached is not appropriate.  Also, the speed of simple lookups on
MySQL when accessed over a local socket is very hard to beat.  DBI is
fast.

Note that this module is built on the Mouse framework, just like the
main CHI modules.

=head1 ATTRIBUTES

=over

=item namespace

The namespace you pass in will be appended to the C<table_prefix> and
used as a table name.  That means that if you don't specify a
namespace or table_prefix the cache will be stored in a table called
C<chi_Default>.

=item table_prefix

This is the prefix that is used when building a table name.  If you
want to just use the namespace as a literal table name, set this to
undef.  Defaults to C<chi_>.

=cut

has 'root_dir' => (
    is      => 'ro',
    isa     => 'Str',
    default => tmpdir(),
);

has 'size' => ( is => 'ro', isa => 'Int', default => 0 );

=item dbh

The main, or rw, DBI handle used to communicate with the db.
If a dbh_ro handle is defined then this handle will only be used
for writing.

This attribute can be set after object creation as well, so in a
persistent environment like mod_perl or FastCGI you may keep an
instance of the cache around and set the dbh on each request after
checking it with ping().

=cut

=item dbh_ro

The optional DBI handle used for read-only operations.  This is
to support master/slave RDBMS setups.

=cut

=item sql_strings

Hashref of SQL strings to use in the different cache operations.
The strings are built depending on the RDBMS that dbh is attached to.

=back

=cut

__PACKAGE__->meta->make_immutable;

=head1 METHODS

=over

=item BUILD

Standard issue Mouse BUILD method.  Used to build the sql_strings.  If
the parameter C<create_table> to C<new()> was set to true, it will
attempt to create the db table.  For Mysql and SQLite the statement is
"create if not exists..." so it's generally harmless.

=cut

sub BUILD {
    my ( $self, $args, ) = @_;

    $MM ||= mm_create( $self->size(), $self->root_dir );
    $HASH ||= mm_make_hash($MM);
}

=item fetch

=cut

sub fetch {
    my ( $self, $key, ) = @_;

    return mm_hash_fetch( $HASH, join( $SEPARATOR, $self->namespace(), $key ) );
}

=item store

=cut

sub store {
    my ( $self, $key, $data, ) = @_;

    return mm_hash_store( $HASH, join( $SEPARATOR, $self->namespace(), $key ),
        $data );
}

=item remove

=cut

sub remove {
    my ( $self, $key, ) = @_;

    return mm_hash_delete( $HASH,
        join( $SEPARATOR, $self->namespace(), $key ) );
}

=item clear

=cut

sub clear {
    my ( $self, ) = @_;

    return mm_hash_clear($HASH);
}

=item get_keys

=cut

sub get_keys {
    my ( $self, ) = @_;

    my @keys;
    my $namespace = $self->namespace();

    for ( my $i = 0 ; $i < mm_hash_scalar($HASH) ; $i++ ) {
        my $key = ( mm_hash_get_entry( $HASH, $i ) )[0];
        if ( !defined $key ) { last }
        my ( $key_namespace, $real_key ) = split( $SEPARATOR, $key );
        next if $key_namespace ne $namespace;
        push @keys, $real_key;
    }

    return @keys;
}

=item get_namespaces

Not supported at this time.

=back

=cut

sub get_namespaces { croak 'not supported' }

=head1 Authors

Original version by Justin DeVuyst.  Current version and maintenance by Perrin Harkins.

=head1 COPYRIGHT & LICENSE

Copyright (C) Justin DeVuyst

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;
